# konrad.smolinski@gmail.com
# date: 25/11/2010
# last update: 29/11/2010
#
# info:
# 	We look at the random coeficient structure with ordered covariate
#	i.e. univariate endogenous variable X with discrete support ;
#	this is set up gives rise to very particular structure where the
#	elements of integrand are 'tiramisu' slices
# 
#
# 	function defined in this library:
#
#	(2)		rcLeaveOut(K)
#	(3)		rcLeaveOutToProbs(K)
#
#
# dependencies: 
#	rcBase() in rcBase.R
# ------------------------------------------------------------------
# rcLeaveOut()
# info:
# 	function returns complete list of a(,,,) elements to take a union over 
# 	and integrate out

rcLeaveOut <- function(K){
	lK <- 2*K	
	supMat <- rcBase(K)
	supMatLeaveOut <- list()
	for(p in 1:K){
	lOut <- p
		for(i in 1:lK){
			temp <- rep(TRUE,lK)

			for(s in 1:lOut){
				idx <- ((i+s-1)%%lK)
				if((i+s-1)==lK) idx <- lK
				temp[idx] <- FALSE 
			}	
			supMatLeaveOut[[(p-1)*lK + i]] <- supMat[temp,]
		}
	}
return(supMatLeaveOut)
}

# Validate
codeVal <- FALSE
if(codeVal){
	 supMatLeaveOut <- rcLeaveOut(K=2)
	 supMatLeaveOut
}
# ------------------------------------------------------------------
# rcLeaveOutIdx()
# info:
# 	function returns complete list of base indecies for integration

rcLeaveOutIdx <- function(K){
	lK <- 2*K	
	supMat <- rcBaseIdx(K)
	supMatLeaveOut <- list()
	for(p in 1:K){
	lOut <- p
		for(i in 1:lK){
			temp <- rep(TRUE,lK)

			for(s in 1:lOut){
				idx <- ((i+s-1)%%lK)
				if((i+s-1)==lK) idx <- lK
				temp[idx] <- FALSE 
			}	
			supMatLeaveOut[[(p-1)*lK + i]] <- supMat[temp]
		}
	}
return(supMatLeaveOut)
}

# Validate
codeVal <- FALSE
if(codeVal){
	cat("\n Validate: rcLeaveOutIdx() : \n\n")		
	 supMatLeaveOut <- rcLeaveOutIdx(K=2)
	 supMatLeaveOut
}


# ------------------------------------------------------------------
# leaveOutToProbs()
# info:
#	function returns a list of index elements to be take from matrix 
#	of conditional distribution (probability matrix)
rcLeaveOutToProbs <- function(K){
	probMat <- matrix(1:(2*K),nrow=2,ncol=K)
	probList <- list()

	supMatLeaveOut <- rcLeaveOut(K)
	# take probabilities corresponding to appropriate a's
	for(i in 1:length(supMatLeaveOut)){
		case <- supMatLeaveOut[[i]]
		# print(case)
		p0 <- apply(!case,2,sum)
		p1 <- apply(case,2,sum)
		probList[[i]] <- probMat[rbind((p0 >= 2),(p1 >= 2))]
	}
return(probList)
}

# Validate:
codeVal <- FALSE
if(codeVal){
	cat("\n Validate: rcLeaveOutToProbs() : \n\n")	
	 probList <- rcLeaveOutToProbs(K=2)
	 probList
}
# ------------------------------------------------------------------